;---------------------------------brute force solution
(defun ciclic-no (a b)
  (and (= (caddr b) (car a)) (= (cadddr b) (cadr a))))

(defun ciclic-digitsp(l)
  (if (null (cdr l)) T
      (and (ciclic-no (car l) (cadr l)) (ciclic-digitsp (cdr l)))))

(defun valid (l)
  (if (>= 1 (length l)) nil
      (let ((sorted-no (sort l #'ciclic-no)))
	(and (ciclic-digitsp sorted-no)
	     (ciclic-no (car (last sorted-no)) (car sorted-no))))))

(defun find-first-4digit(func)
  (loop for i = 1 then (1+ i)
       when (< 999 (funcall func i))
       do (return i)))

(defun make-no-list(n f)
  (let ((x (funcall f n)))
    (list (digits x) x n f)))

(defun first-number(f)
  (make-no-list (find-first-4digit f) f))
;  (let* ((first (find-first-4digit f)) (no (funcall f first)))
;    (list (digits no) no first f)))

(defun next-no (n)
  (make-no-list (1+ (caddr n)) (cadddr n)))

(defun first-solution(polygonal)
  (mapcar #'first-number polygonal))

(defvar polygonal-funct (list #'triangle #'square #'pentagonal #'hexagonal #'heptagonal #'octagonal))

(defun next-solution(f)
;  (print (mapcar #'cadr f))
  (cond ((null f) ());end of the list
	((<= 10000 (cadar f)) (cons (first-number (cadddr (car f))) (next-solution (cdr f)))) ;restart
	((null (cdr f)) (list (next-no (car f)))) ;last number
	((<= 10000 (cadadr f)) (cons (next-no (car f)) (next-solution (cdr f)))) ;increase
	(t (cons (car f) (next-solution (cdr f))))))

(defun find-solution()
  (loop for i from 1 to 1000000
     for sol = (first-solution polygonal-funct) then (next-solution sol)
     ;when (= i 1000000) do (and (setf i 0) (print (mapcar #'cadr sol)))
     when (valid (mapcar #'car sol)) do (return sol)))